home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / doors_2 / twview93.zip / PORTDISP.INC < prev    next >
Text File  |  1992-06-18  |  9KB  |  273 lines
  1. function compatible( i1, i2 : stuff; greed, profit : boolean ) : boolean;
  2. { if each sells something the other buys; if greed is true, only org/equip
  3. trades, and if profit is true, equip must be traded. }
  4. begin
  5.   if i2 = -1 then                                { not a port }
  6.     compatible := false
  7.   else if greed then                             { want equip/organic }
  8.     case i1 of
  9.       Class0, 0, 1, 6, 7 : compatible := false;
  10.       2, 3 : compatible := i2 in [4,5];
  11.       4, 5 : compatible := i2 in [2,3];
  12.     end {case}
  13.   else if profit then                            { want equip/fuel }
  14.     case i1 of                                   { so exclude equip/organic}
  15.       Class0, 0, 2, 5, 7 : compatible := false;
  16.       1 : compatible := i2 in [4, 6];
  17.       3 : compatible := i2 = 6;
  18.       4 : compatible := i2 = 1;
  19.       6 : compatible := i2 in [1, 3];
  20.     end {case}
  21.   else                                           { want fuel/organic }
  22.     case i1 of
  23.       Class0, 0, 3, 4, 7 : compatible := false;
  24.       1 : compatible := i2 = 2;
  25.       2 : compatible := i2 = 1;
  26.       5 : compatible := i2 = 6;
  27.       6 : compatible := i2 = 5;
  28.     end; {case}
  29. end;
  30.  
  31. function deal( good1, good2 : stuff ) : string;
  32. { Port type "good1" selling to port type "good2" }
  33. const
  34.   ND = 'no deal';
  35.   F  = 'Fuel Ore';
  36.   O  = 'Organics';
  37.   Q  = 'Equipment';
  38.   any = 'anything';
  39.  
  40. begin
  41.   deal := ND;
  42.   case good1 of
  43.     Class0, 0 : ;  {error}
  44.         1 : if good2 in [0,2,4,6] then deal := F;
  45.         2 : if good2 in [0,1,4,5] then deal := O;
  46.         3 : if good2 in [0,4] then deal := O + ' or ' + F
  47.             else if good2 in [1,5] then deal := O
  48.             else if good2 in [2,6] then deal := F;
  49.         4 : if good2 in [0,1,2,3] then deal := Q;
  50.         5 : if good2 in [0,2] then deal := Q + ' or ' + F
  51.             else if good2 in [1,3] then deal := Q
  52.             else if good2 in [4,6] then deal := F;
  53.         6 : if good2 in [0,1] then deal := Q + ' or ' + O
  54.             else if good2 in [2,3] then deal := Q
  55.             else if good2 in [4,5] then deal := O;
  56.         7 : case good2 of
  57.                Class0,7 : ; {error}
  58.                0 : deal := any;
  59.                1 : deal := Q + ' or ' + O;
  60.                2 : deal := Q + 'or ' + F;
  61.                3 : deal := Q;
  62.                4 : deal := O + ' or ' + F;
  63.                5 : deal := O;
  64.                6 : deal := F;
  65.              end; {case 7}
  66.         end; {case}
  67. end; {deal}
  68.  
  69. function letterOfGood( g : goods ) : char;
  70. begin
  71.   case g of
  72.     fuel      : LetterOfGood := 'F';
  73.     Organics  : LetterOfGood := 'O';
  74.     Equipment : LetterOfGood := 'E';
  75.   end; {case}
  76. end; {letterOfGood}
  77.  
  78. procedure ComputeStores( psell, pbuy : PortIndex; var f1, f2 : integer;
  79.                          which : goods; dump : boolean; var into : text);
  80. var
  81.   level1, level2 : integer;
  82.   mss : string;
  83. begin
  84.   level1 := space.ports.data[ psell ].amts[ which ];
  85.   level2 := space.ports.data[ pbuy ].amts[ which ];
  86.   f1 := min( min( abs(level1), abs(level2)), f1 );
  87.   mss := letterOfGood( which ) + ':' + str( level1, 5) + ' to ' +
  88.          str( level2, 4) + '  ';
  89.   write( mss );
  90.   if dump then
  91.     write( into, mss );
  92.   f2 := round( sqrt( sqrt( space.ports.data[psell].usage[which] *
  93.              space.ports.data[pbuy].usage[which] ) * f2 ) );
  94. end; {ComputeStores}
  95.  
  96. procedure DisplayStores( psell, pbuy : PortIndex; s : string;
  97.                         var f1, f2 : integer;
  98.                         EOonly, Dump : boolean;  var T : text );
  99. { we are given two ports, and a string s that represents the goods we are
  100. going to be trading there.  For each good in s compute the minimum of
  101. the stores we have to sell and amount to purchase, and store the maximum in f,
  102. while also displaying the quantities the port holds. }
  103. begin
  104.   if not EOonly then
  105.     if pos( 'Fuel', s ) > 0 then
  106.       ComputeStores( psell, pbuy, f1, f2, Fuel, Dump, t );
  107.   if pos( 'Organic', s ) > 0 then
  108.     ComputeStores( psell, pbuy, f1, f2, Organics, Dump, t );
  109.   if pos( 'Equip', s ) > 0 then
  110.     ComputeStores( psell, pbuy, f1, f2, Equipment, Dump, t );
  111. end; {DisplayStores}
  112.  
  113. procedure PortTradeFactor( s1, s2 : sector;
  114.                            items12, items21 : string;
  115.                            EOonly, FileDump : boolean;
  116.                        var DumpFile : text );
  117. { Print port information from these two ports corresponding to trading
  118.   items from 1 to 2 and from 2 to 1; compute relative factor. }
  119. var
  120.   p1, p2 : PortIndex;
  121.   factor1, factor2 : integer;
  122.   result : integer;
  123.   line : string;
  124. begin
  125.   p1 := PortNumber( s1 );
  126.   p2 := PortNumber( s2 );
  127.   if (p1 = 0) or (p2 = 0) then
  128.     begin
  129.       if p1 = 0 then
  130.         line := 'No info available for ' + str( s1 , 1)
  131.       else if p2 = 0 then
  132.         line := 'No info available for ' +  str( s2, 1 );
  133.       writeln( line );
  134.       if Filedump then
  135.         writeln( Dumpfile, line );
  136.     end
  137.   else
  138.     begin
  139.       write( 'Quantities: ' );
  140.       if FileDump then
  141.         write(DumpFile, 'Quantities: ');
  142.       factor1 := maxint; factor2 := 100;
  143.       DisplayStores( p1, p2, items12, factor1, factor2, EOonly, FileDump, DumpFile);
  144.       DisplayStores( p2, p1, items21, factor1, factor2, EOonly, FileDump, DumpFile);
  145.       if factor2 = 0 then
  146.         writeln(' Factor: ???')
  147.       else
  148.         writeln(' Factor: ', factor1, ', ', factor2,'%' );
  149.       if FileDump then
  150.         writeln(DumpFile,' Factor: ', factor1, ', ', factor2,'%');
  151.     end; {else}
  152. end; {PortTradeFactor}
  153.  
  154. procedure AddEtc( s : sector; var line : string );
  155. { add special information to code Fighters there or SpaceLane there }
  156. var
  157.   p : PortIndex;
  158. begin
  159.   if space.sectors[s].etc and HasFighters <> nothing then
  160.     line := line + 'F'
  161.   else if space.sectors[s].etc and SpaceLane <> nothing then
  162.     line := line + 'SL';
  163.   p := PortNumber( s );
  164.   if p <> 0 then
  165.     with space.ports do
  166.       if (data[ p ].amts[equipment] <> 0) and 
  167.          (data[p].usage[equipment]=0) then
  168.         line := line + 'B';
  169. end; {AddEtc}
  170.  
  171. procedure DisplayLotsOfPortStuff( s, s1, WhichDistanceIndex : sector;
  172.                                   logging, AsciiDump, showLevels, EquipOnly : boolean;
  173.                                   var f, h : text);
  174. var
  175.   g, g1 : stuff;
  176.   line  : string;
  177. begin
  178.   if logging then
  179.     begin
  180.       writeln( h, 'R', s );
  181.       writeln( h, 'R', s1);
  182.     end; {log}
  183.   g := space.sectors[s].portType;
  184.   g1 := space.sectors[s1].portType;
  185.   line := '(' + str( s, 3);
  186.   AddEtc( s, line );
  187.   line := line + ' & ' + str(s1,3);
  188.   AddEtc( s1, line );
  189.   line := line + ' ) at distance ' + str( distances[WhichDistanceIndex].d,3)
  190.           + ' trading ' +  deal( g, g1) + ' for ' +
  191.            deal( g1, g );
  192.   writeln( line );
  193.   if AsciiDump then
  194.     writeln( f, line );
  195.   if ShowLevels then
  196.     PortTradeFactor( s, s1, deal( g, g1), deal( g1, g ),
  197.                      EquipOnly, AsciiDump, f );
  198. end; {Display Lots of Port Stuff}
  199.  
  200. procedure SearchPairs( NumPorts : integer;
  201.                        logging : boolean; var h : text;
  202.                        asciiDump : boolean; var f : text;
  203.                        EquipOnly, EquipAny, ShowLevels : boolean );
  204. var
  205.   i         : integer;
  206.   s, s1     : sector;
  207.   g, g1     : stuff;
  208.   t         : warpIndex;
  209.   NumPairs  : integer;
  210.   PauseAt   : integer;
  211.   line      : string;
  212.  
  213. begin
  214.   NumPairs := 0;
  215.   if ShowLevels then
  216.     PauseAt := 10
  217.   else
  218.     PauseAt := 20;
  219.   for i := 1 to NumPorts do
  220.     begin
  221.       s := distances[ i ].s;
  222.       g := space.sectors[s].portType;
  223.       if space.sectors[s].number <> Unexplored then
  224.         for t := 1 to space.sectors[s].number do
  225.           begin
  226.             s1 := space.sectors[s].data[t];
  227.             g1 := space.sectors[s1].porttype;
  228.             if  (g1<> NotAPort) and (g < g1) and IsWarp( s1, s) then
  229.                 { must be a port; print only once; check if can get back }
  230.               if compatible( g, g1, EquipOnly, EquipAny ) then
  231.                 begin
  232.                   DisplayLotsOfPortStuff(s, s1, i, logging, asciidump, 
  233.                                         showlevels, EquipOnly, f, h);
  234.                   NumPairs := NumPairs + 1;
  235.                   if numPairs mod PauseAt = 0 then
  236.                     if not prompt('more? ') then
  237.                       exit;
  238.                 end; {if if}
  239.           end; {for t}
  240.     end; {for i}
  241. end; {SearchPairs}
  242.  
  243. procedure pairport;
  244. var
  245.   s        : sector;
  246.   QuantInfo,
  247.   Eonly,
  248.   Greedy   : boolean;
  249.   NumSectors : sectorIndex;
  250.   AsciiDump,
  251.   loggit   : boolean;
  252.   h, fp    : text;
  253. begin
  254.   SortPorts( NumSectors );
  255.   QuantInfo := prompt('Do you want to see port quantity information? ');
  256.   greedy := prompt('Do you want to see only Equip/Organic trades? ');
  257.   if not greedy then
  258.     Eonly := prompt('Do you want to see only Equip/Fuel trades? ');
  259.   if not greedy and not Eonly then
  260.     writeln('Showing only Organic/Fuel trades.');
  261.   loggit := LogToDisk( h,
  262.         'Do you want to log the results in a format suitable for upload? ',
  263.         BBSname+'.upl' );
  264.   AsciiDump := LogToDisk( fp,
  265.         'Do you want an echo of the results to an ascii file? ',
  266.         BBSName+'.txt');
  267.   SearchPairs( NumSectors, Loggit, h, AsciiDump, fp, greedy, Eonly, QuantInfo );
  268.   if loggit then
  269.     close( h );
  270.   if AsciiDump then
  271.     close( fp );
  272. end; {pair ports}
  273.